Visual Basic Toolbox/Visual Basic Toolbox (P.I.E.)(1996).ISO/internet/appc/echo.frm

Visual Basic Form | 1995-11-12 | 11.0 KB | 336 lines

VERSION 2.00
Begin Form frmEcho
   BackColor       =   &H00C0C0C0&
   BorderStyle     =   3  'Fixed Double
   Caption         =   "Echo!"
   ClientHeight    =   4920
   ClientLeft      =   3705
   ClientTop       =   3405
   ClientWidth     =   6255
   Height          =   5325
   Icon            =   ECHO.FRX:0000
   Left            =   3645
   LinkTopic       =   "Form1"
   ScaleHeight     =   4920
   ScaleWidth      =   6255
   Top             =   3060
   Width           =   6375
   Begin TextBox txtServer
      BackColor       =   &H00C0C0C0&
      Height          =   315
      Left            =   2550
      MultiLine       =   -1  'True
      TabIndex        =   13
      Top             =   420
      Width           =   2175
   End
   Begin CommandButton cmdSend
      BackColor       =   &H00C0C0C0&
      Caption         =   "&Send"
      Height          =   315
      Left            =   4980
      TabIndex        =   5
      Top             =   2640
      Width           =   1215
   End
   Begin TextBox txtReceivedData
      BackColor       =   &H00C0C0C0&
      Height          =   855
      Left            =   270
      MultiLine       =   -1  'True
      TabIndex        =   6
      Top             =   3870
      Width           =   4575
   End
   Begin TextBox txtSendData
      Height          =   855
      Left            =   300
      MultiLine       =   -1  'True
      TabIndex        =   4
      Text            =   "Hello World"
      Top             =   2640
      Width           =   4575
   End
   Begin CommandButton cmdDeallocate
      BackColor       =   &H00C0C0C0&
      Caption         =   "&Deallocate (selected)"
      Height          =   315
      Left            =   2550
      TabIndex        =   3
      Top             =   1560
      Width           =   2175
   End
   Begin CommandButton cmdAllocate
      BackColor       =   &H00C0C0C0&
      Caption         =   "&Allocate (new)"
      Height          =   315
      Left            =   2550
      TabIndex        =   2
      Top             =   1200
      Width           =   2175
   End
   Begin ListBox lstConversation
      Height          =   1005
      Left            =   300
      TabIndex        =   1
      Top             =   1200
      Width           =   2175
   End
   Begin ComboBox cboSystemList
      Height          =   300
      Left            =   300
      Style           =   2  'Dropdown List
      TabIndex        =   0
      Top             =   420
      Width           =   1635
   End
   Begin CommandButton cmdExit
      BackColor       =   &H00C0C0C0&
      Caption         =   "&Exit"
      Height          =   315
      Left            =   4980
      TabIndex        =   7
      Top             =   3900
      Width           =   1215
   End
   Begin Label lblServer
      BackStyle       =   0  'Transparent
      Caption         =   "Server Program"
      Height          =   225
      Left            =   2520
      TabIndex        =   12
      Top             =   120
      Width           =   1455
   End
   Begin Label lblReceiveData
      BackStyle       =   0  'Transparent
      Caption         =   "Data echoed back from the AS/400:"
      Height          =   315
      Left            =   300
      TabIndex        =   11
      Top             =   3600
      Width           =   3195
   End
   Begin Label lblSendData
      BackStyle       =   0  'Transparent
      Caption         =   "3. Enter data to send to the AS/400 and press 'Send'."
      Height          =   315
      Left            =   60
      TabIndex        =   10
      Top             =   2340
      Width           =   4695
   End
   Begin Label lblConversations
      BackStyle       =   0  'Transparent
      Caption         =   "2. Allocate one or more conversations."
      Height          =   315
      Left            =   60
      TabIndex        =   9
      Top             =   900
      Width           =   3495
   End
   Begin Label lblSystems
      BackStyle       =   0  'Transparent
      Caption         =   "1. Select a system."
      Height          =   255
      Left            =   60
      TabIndex        =   8
      Top             =   120
      Width           =   1695
   End
Option Explicit
 ' Constants:
  Const nCOMM_BUFFER_SIZE = 500        ' communications buffer size
 ' Variables:
  Dim nPartnerMAX      As Integer      ' maximum read attempts
  Dim sPartnerICF      As String       ' ICF program device
  Dim sPartnerLIB      As String       ' partner library
  Dim sPartnerPGM      As String       ' partner program
  Dim sPartnerSYS      As String       ' partner system
Sub cmdAllocate_Click ()
 ' Description:
 '  Allocate a BASIC conversation
 ' Variables:
  Static asPIPArray(1) As String      ' PIP data sent
  Dim lConvID          As Long        ' conversation ID returned
  Dim nRC              As Integer     ' return code received
  ' is router loaded?
  If zzCARouterLoaded(Me.hWnd) <> True Then
    gsMBText = "The router is not loaded."
    gsMBText = gsMBText & " Cannot allocate a conversation at this time."
    MsgBox gsMBText, MB_ICONSTOP
    Exit Sub
  End If
  ' is system selected?
  If cboSystemList = gsEMPTY Then
    MsgBox "Select a system.", MB_ICONSTOP
    cboSystemList.SetFocus
    Exit Sub
  End If
  ' setup PIP data which contains library to use
  asPIPArray(0) = Left$(sPartnerLIB & Space$(10), 10)
  ' allocate a BASIC conversation
  lConvID = zzCAConvStartBasic(Me.hWnd, nCOMM_BUFFER_SIZE, cboSystemList, Trim$(sPartnerLIB) & "/" & Trim$(sPartnerPGM), zzCAFormattedPIP(Me.hWnd, asPIPArray()), nRC)
  ' if started then add to list
  If lConvID <> 0 Then
    lstConversation.AddItem Str$(lConvID)
    lstConversation.ListIndex = lstConversation.ListCount - 1
  End If
End Sub
Sub cmdDeallocate_Click ()
 ' Description:
 '  Deallocate a BASIC conversation
  ' remove selected conversation
  If Val(lstConversation) <> 0 Then
    If zzCAConvStopFlush(Me.hWnd, Val(lstConversation)) = gnCA_OK Then
      lstConversation.RemoveItem lstConversation.ListIndex
    Else
    End If
  End If
End Sub
Sub cmdExit_Click ()
  ' end program
  Unload Me
End Sub
Sub cmdSend_Click ()
 ' Description:
 '  Send a record
 ' Variables:
  Dim bCAPartnerWishesToSend As Integer      ' partner wishes to send
  Dim nCArc                  As Integer      ' API return code
  Dim sCAData                As String       ' data
  Dim nCAWhatRcvd            As Integer      ' what is being sent back
  Dim sCADataBlock           As String       ' data block
  ' select a conversation
  If Val(lstConversation) = 0 Then
    MsgBox "Select a conversation", MB_ICONSTOP
    Exit Sub
  End If
  ' tell partner I'm want to send
  nCArc = zzCATellWantToSend(Me.hWnd, Val(lstConversation))
  ' send information
  nCArc = zzCASendBasic(Me.hWnd, Val(lstConversation), txtSendData, Len(txtSendData), bCAPartnerWishesToSend)
  ' tell partner I'm ready to receive
  nCArc = zzCATellReadyToReceive(Me.hWnd, Val(lstConversation))
  sCADataBlock = gsEMPTY
  Screen.MousePointer = HOURGLASS
  cmdSend.Enabled = False
  ' loop to get returned information
    ' receive record
    nCArc = zzCAReceiveBasic(Me.hWnd, Val(lstConversation), Len(txtSendData), sCAData, nCAWhatRcvd, bCAPartnerWishesToSend)
    DoEvents
    ' action based on return code
    Select Case nCArc

      ' everything OK
      Case gnCA_OK

        ' if partner said ready to receive more then exit loop
        If nCAWhatRcvd = gnCA_RCVD_SEND Then
          Exit Do

        ' else add data to block
        Else
          sCADataBlock = sCADataBlock & sCAData
        End If

      ' don't show message on busy, or unsuccessful
      Case gnCA_APPC_BUSY, gnCA_UNSUCCESSFUL

      ' show any other error
      Case Else
        MsgBox zzCAGetRCText(nCArc, True), MB_ICONSTOP
        Screen.MousePointer = DEFAULT
        cmdSend.Enabled = True
        Exit Sub
    End Select
  Loop
  ' put data returned into text box
  Screen.MousePointer = DEFAULT
  cmdSend.Enabled = True
  txtReceivedData.Text = Mid$(sCADataBlock, gnCA_BASIC_HEADER_LEN + 1, Len(sCADataBlock) - gnCA_BASIC_HEADER_LEN)
End Sub
Sub Form_Load ()
 ' Variables:
  Dim n1             As Integer    ' loop counter
  ' setup global variables
  Call zzSetGlobalVariables
  ' center form
  zzFormCenter Me
  ' setup title
  App.Title = Caption
  ' setup INI file and section
  n1 = zzINISetFile(App.Path & "\APPC.INI")
  n1 = zzINISetSection("ECHO")
  ' get AS/400 system
  n1 = zzINIGetString("System", sPartnerSYS)
  ' get AS/400 library
  n1 = zzINIGetString("Library", sPartnerLIB)
  If sPartnerLIB = gsEMPTY Then
    MsgBox "AS/400 library reference invalid. Check APPC.INI files for proper values."
    End
  End If
  ' get AS/400 program
  n1 = zzINIGetString("Program", sPartnerPGM)
  If sPartnerPGM = gsEMPTY Then
    MsgBox "AS/400 program reference invalid. Check APPC.INI files for proper values."
    End
  End If
  ' get AS/400 ICF device
  n1 = zzINIGetString("Device", sPartnerICF)
  If sPartnerICF = gsEMPTY Then
    MsgBox "AS/400 ICF device reference invalid. Check APPC.INI files for proper values."
    End
  End If
  ' get maximum read attempts
  n1 = zzINIGetInteger("MaxAttempts", nPartnerMAX)
  If nPartnerMAX = 0 Then
    MsgBox "APPC retry attempts setting invalid. Check APPC.INI files for proper values."
    End
  End If
  ' show server program
  txtServer = sPartnerLIB & "/" & sPartnerPGM
  ' if router loaded
  If zzCARouterLoaded(Me.hWnd) = True Then
    ' put list into control
    Call zzCAPutSystemListIntoCtrl(Me.hWnd, cboSystemList)
    ' see if match found
    For n1 = 0 To cboSystemList.ListCount - 1
      If cboSystemList.List(n1) = sPartnerSYS Then
        cboSystemList.ListIndex = n1
        Exit For
      End If
    Next
  End If
End Sub
Sub Form_QueryUnload (Cancel As Integer, UnloadMode As Integer)
 ' Variables:
  Dim n1 As Integer   ' loop counter
  ' if conversations active
  If lstConversation.ListCount <> 0 Then
    ' ask user if they want to dellocate and leave
    If MsgBox("Deallocate conversations?", MB_ICONQUESTION Or MB_YESNO) = IDYES Then
      ' end all conversations
      Screen.MousePointer = HOURGLASS
      For n1 = (lstConversation.ListCount - 1) To 0 Step -1
        If zzCAConvStopFlush(Me.hWnd, Val(lstConversation.List(n1))) = gnCA_OK Then
          lstConversation.RemoveItem n1
          lstConversation.Refresh
        End If
      Next
      Screen.MousePointer = DEFAULT
    ' do not end
    Else
      Cancel = True
    End If
  End If
End Sub
Sub txtReceivedData_GotFocus ()
  ' cannot goto data returned
  cmdExit.SetFocus
End Sub
Sub txtServer_GotFocus ()
  ' cannot goto this field
  cmdAllocate.SetFocus
End Sub